Internet Info 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / b / ikxmac.asm < prev next >

Wrap

Assembly Source File | 1992-09-29 | 44.4 KB | 562 lines

*COPY RTEXT 00800000 MACRO 00801000 &LABEL RTEXT &BUF,&PROMPT=,&E= 00802000 .* Read from the terminal, possible prompt. Get length read in R0. 00803000 .* &1: read buffer (len=130) (LA), &PROMPT(1)= prompt buf. if any 00804000 .* (LA/R), &PROMPT(2)= prompt length (LA/R), &E= branch if error 00805000 GBLC &KVRSN,&KSYS @SC89027 00806000 AIF ('&KVRSN' EQ '4.2' OR '&KSYS' EQ '').VOK @SC90072 00807000 MNOTE 16,'* * * --> IKXMAC version number should be &KVRSN' @SC89027 00808000 .VOK ANOP @SC89027 00809000 &LABEL DS 0H @SC86299 00810000 AIF (T'&BUF EQ 'O').ERRB @SC87268 00811000 AIF (T'&PROMPT EQ 'O').NOPR @SC87268 00812000 AIF (N'&PROMPT NE 2).ERRP @SC87268 00813000 AIF ('&PROMPT(1)' EQ '' OR '&PROMPT(2)' EQ '').ERRP @SC87268 00814000 LREG 1,&PROMPT(1) @SC90264 00815000 LREG 0,&PROMPT(2) @SC90264 00816000 STM 0,1,GTLPRPS Save prompt ptrs @SC90264 00817000 AGO .GETL @SC90264 00818000 .NOPR XC GTLPRPS,GTLPRPS @SC90264 00819000 .GETL KCALL GETLIN,&BUF,E=&E @SC88095 00820000 MEXIT @SC87268 00821000 .ERRB MNOTE 2,'BUFFER ADDRESS OMITTED' @SC87268 00822000 MEXIT @SC87268 00823000 .ERRP MNOTE 2,'INVALID PROMPT PARAMETER' @SC87268 00824000 MEND 00825000 *COPY WTEXT 00826000 MACRO 00827000 &LABEL WTEXT &ARG,&LEN 00828000 .* Display some text, e.g., WTEXT 'Hi there' or WTEXT (3),(4) 00829000 .* Preserves R2-R14 00830000 .* &1: 'text' (where text has no doubled ' or & characters) OR 00831000 .* &1: adr of text (LA/R), &2: length of text (LA/R) 00832000 &LABEL PTEXT &ARG,&LEN,AREG=1,LREG=0 @SC86295 00833000 BAL 15,WTEXT @SC87020 00834000 MEND 00835000 *COPY DMSFREE 00836000 MACRO 00837000 &LABEL DMSFREE &DWORDS=(0),&ERR= 00838000 .* Obtain free storage block: len=8*(R0). Returns ptr in R1, but 00839000 .* preserves registers 2-13 00840000 .* &DWORDS= length in doublewords should be in R0, 00841000 .* &ERR= branch if failure 00842000 &LABEL LREG 0,&DWORDS @SC86299 00843000 SLA 0,3 @SC86299 00844000 ST 0,GTMLEN Bytes requested @SC90264 00845000 AIF ('&ERR' EQ '').DOORDIE @SC90264 00846000 EXEC CICS GETMAIN SET(1) FLENGTH(GTMLEN) NOHANDLE, @SC90264 00847000 L 15,DFHEIBP @SC90264 00848000 CLC F0,EIBRCODE-DFHEIBLK(15) @SC90264 00849000 BNE &ERR @SC90264 00850000 AGO .DONE @SC90264 00851000 .DOORDIE ANOP @SC90264 00852000 EXEC CICS GETMAIN SET(1) FLENGTH(GTMLEN), @SC90264 00853000 .DONE ANOP @SC90264 00854000 MEND 00855000 *COPY DMSFRET 00856000 MACRO 00857000 &LABEL DMSFRET &DWORDS=(0),&LOC=(1),&ERR= 00858000 .* Return free storage block: len=8*(R0), adr=(R1). Preserve R2-13. 00859000 .* &DWORDS= length in doublewords should be in R0, &LOC= adr (in R1), 00860000 .* &ERR= branch if failure 00861000 .* Note: &DWORDS is ignored @SC90264 00862000 &LABEL ST 2,GTMSAV @SC90264 00863000 LREG 2,&LOC @SC90264 00864000 EXEC CICS FREEMAIN DATA(0(,2)), @SC90264 00865000 L 2,GTMSAV @SC90264 00866000 MEND 00867000 *COPY WRITF 00868000 MACRO 00869000 &LABEL WRITF &TICK,&BUFFER=,&BSIZE=,&E= 00870000 .* Write to a disk file (ticket ptr in R1) 00871000 .* &1: adr of file access ticket returned by OPENF (A), 00872000 .* &BUFFER= data ptr (LA/R), &BSIZE= data length (LA/R) - if either is 00873000 .* given, it replaces FDB value (see OPENF), &E= branch on error 00874000 &LABEL READF &TICK,BUFFER=&BUFFER,BSIZE=&BSIZE,E=&E,CODE=10 00875000 MEND 00876000 *COPY READF 00877000 MACRO 00878000 &LABEL READF &TICK,&NONUM,&BUFFER=,&BSIZE=,&E=,&CODE=9 00879000 .* Read from disk file (or write) (see WRITF, but also...) 00880000 .* &2: NONUM means chop off numbers 00881000 LCLC &R @SC86299 00882000 LCLA &C @SC88101 00883000 &C SETA &CODE @SC88101 00884000 AIF (T'&NONUM EQ 'O').RDC @SC88101 00885000 AIF ('&NONUM' NE 'NONUM' OR &CODE NE 9).ER1 @SC88101 00886000 &C SETA 0 Code 0 means exclude sequence nos.@SC88101 00887000 .RDC ANOP @SC88101 00888000 &LABEL L 1,&TICK @SC86299 00889000 AIF ('&BUFFER' EQ '').BZ @SC86299 00890000 AIF ('&BUFFER'(1,1) NE '(').BLA @SC86299 00891000 &R SETC '&BUFFER(1)' @SC86299 00892000 AGO .BST @SC86299 00893000 .BLA LA 15,&BUFFER @SC86299 00894000 &R SETC '15' @SC86299 00895000 .BST ST &R,FDBBUFF-FABD(1) @SC86299 00896000 .BZ AIF ('&BSIZE' EQ '').SZ @SC86299 00897000 AIF ('&BSIZE'(1,1) NE '(').SLA @SC86299 00898000 &R SETC '&BSIZE(1)' @SC86299 00899000 AGO .SST @SC86299 00900000 .SLA LA 15,&BSIZE @SC86299 00901000 &R SETC '15' @SC86299 00902000 .SST ST &R,FDBBSIZ-FABD(1) @SC86299 00903000 .SZ LA 0,&C @SC88101 00904000 KCALL DISKIO,E=&E @SC86299 00905000 MEXIT 00906000 .ER1 MNOTE 2,'INVALID PARAMETER ''&NONUM''' @SC88101 00907000 MEND 00908000 *COPY SAVEF 00909000 MACRO 00910000 &LABEL SAVEF &TICK,&E= @SC88168 00911000 .* Update disk directory for given file (ticket ptr in R1) 00912000 .* &1: adr of file access ticket (A), &E= branch on error 00913000 &LABEL L 1,&TICK @SC88168 00914000 READF &TICK,E=&E,CODE=21 @SC88168 00915000 MEND 00916000 *COPY KSETKW 00917000 MACRO 00918000 KSETKW , @SC87166 00919000 .* Define system-specific SET/SHOW parameters (keywords) 00920000 KW 'DELIM',SHODLM,MIN=4 @SC88095 00921000 KW 'PREFIX',SHODST,MIN=3 @SC87166 00922000 MEND 00923000 *COPY KSETPRC 00924000 MACRO 00925000 KSETPRC 00926000 .* System-specific SET handlers (in any order). No operands. 00927000 SETDLM NTOKN N=SETDLM1,H=SETDLMH @SC88095 00928000 LTR 7,7 Exactly one character? @SC88095 00929000 BNZ SETDLMH No, explain it @SC88095 00930000 MVC LNDLM,0(6) Yes, use that character @SC88095 00931000 B RTRN0 @SC88095 00932000 SETDLM1 MVI LNDLM,C' ' Turn delimiter off @SC88095 00933000 B RTRN0 @SC88095 00934000 SETDLMH PTEXT 'Line delimiter: one char or none' @SC88095 00935000 B SUBERR @SC88095 00936000 SETDST KCALL CWDSET @SC86164 00937000 B RTRN Preserve return code @SC86295 00938000 MEND 00939000 *COPY KSHOPRC 00940000 MACRO 00941000 KSHOPRC 00942000 .* System-specific SHOW handlers (in same order as KW). No operands. 00943000 SHODLM LA 8,LNDLM Show delimiter @SC88095 00944000 BAL 14,SHOCHR @SC88095 00945000 B SETDLM @SC88095 00946000 SHODST LA 8,DEST @SC86316 00947000 LH 9,DESTL Get length @SC86316 00948000 BAL 14,SHOCHRN @SC86295 00949000 B SETDST @SC87166 00950000 MEND 00951000 *COPY KFILKW 00952000 MACRO 00953000 KFILKW , @SC87166 00954000 .* Define system-specific file attribute parameters (keywords) 00955000 KW 'RECFM',SHORFM @SC87166 00956000 MEND 00957000 *COPY KFILSET 00958000 MACRO 00959000 KFILSET 00960000 .* Specific SET FILE handlers (any order). No operands. 00961000 SETRECVF MVC FILRCF,OPRND Copy RECFM @SC91033 00962000 B RTRN0 @SC87012 00963000 * @SC87012 00964000 SETRFM BAL 4,SETSCN @SC87012 00965000 KW 'FIXED',SETRECVF @SC87012 00966000 KW 'VARIABLE',SETRECVF @SC87012 00967000 KW 'UNDEFINED',SETRECVF @SC86295 00968000 KW , @SC87012 00969000 MEND 00970000 *COPY KFILSHO 00971000 MACRO 00972000 KFILSHO 00973000 .* Specific SHOW FILE handlers (same order as KW). No operands. 00974000 SHORFM LA 8,FILRCF @SC88120 00975000 BAL 14,SHOCHR @SC87012 00976000 B SETRFM @SC87166 00977000 MEND 00978000 *COPY FDBD 00979000 MACRO 00980000 FDBD 00981000 .* Map of File Descriptor Block + File Access Block 00982000 .* Required items below: FABCOMM, FDBD-FDBLRC, FDBSIZE, FDBDATE, 00983000 .* FDBDLRTR, FDBCOP, FDBINFO. See also FDBPAT. 00984000 LFUID EQU 4 Length of user id in filespec @SC90264 00985000 LFFNM EQU 8 Length of file id in filespec @SC90264 00986000 LFID EQU 1+LFUID+LFFNM Length of internal filespec @SC90264 00987000 LFKEY EQU LFUID+LFFNM+5 Length of KSDS key @SC90264 00988000 FABD DSECT , @SC86295 00989000 FABRESP DS XL6 Saved response code @SC90264 00990000 FABNORD DS H Byte count of last transfer @SC90264 00991000 FDBD DS 0F Beginning of short descriptor @SC86295 00992000 FDBBUFF DS A Buffer ptr @SC86295 00993000 FDBBSIZ DS F Max record length @SC86295 00994000 FDBRCF DS C Record format @SC86295 00995000 FDBFLGS DS X Flags @SC86295 00996000 FDBACTV EQU X'80' File is already open @SC86295 00997000 * SVATT EQU X'40' Preserve attributes @SC90033 00998000 * APPN EQU X'10' DISP=MOD @SC86295 00999000 FDBLRC DS H File record length @SC86295 01000000 FDBSIZE DS F File size in Kbytes @SC86299 01001000 FDBCOP EQU *-FDBD Length to copy for OPEN @SC86295 01002000 FDBDATE DS XL7 Time stamp: packed yyyymmddhhmmss @SC88235 01003000 * Must align FABFID to abut FABRN (halfword) @SC90264 01004000 FABFID DS 0CL(LFID) File designator @SC90264 01005000 FABFLGS DS X Flags indicating type of file @SC90264 01006000 FABFMAIN EQU X'01' Flag for MAIN TS queue @SC90264 01007000 FABFTS EQU X'02' Flag for TS queue @SC90264 01008000 FABFTD EQU X'04' Flag for TD queue @SC90264 01009000 FABFPGM EQU X'08' Flag for pipe file @SC90264 01010000 FABFSPL EQU X'10' Flag for spool file @SC90264 01011000 FABFTAK EQU X'20' Flag for internal Kermit file @SC90264 01012000 FABFUID DS CL(LFUID) User name @SC90264 01013000 FABFNAM DS CL(LFFNM) File name @SC90264 01014000 FABRN DS H Record number @SC90264 01015000 FDBNREC DS H Number of records @SC90264 01016000 FDBFL2 DS X More flags @SC90264 01017000 FDBXRCF DS X External format flags @SC90264 01018000 FDBXLRC DS H External old LRECL @SC90264 01019000 FDBXBLK DS H External old block size @SC90264 01020000 FDBINFO EQU *-FDBD Length of info returned @SC86295 01021000 FABIOF DS X More flags @SC90264 01022000 FABLRTR DS F Record length for truncation @SC88120 01023000 FABUWORD DS F Reserved for user applications @SC90264 01024000 FABCOMM DS CL8 Command name @SC87351 01025000 .* CLOSE Close file named in FABFID @SC90264 01026000 .* CWD Set new user directory or QFN prefix: string is at@SC90264 01027000 .* FABFID+2 with 2-byte unsigned length at FABFID @SC90264 01028000 .* DELETE Delete file named in FABFID @SC90264 01029000 .* OPEN I Open file named in FABFID for input @SC90264 01030000 .* OPEN O Open file named in FABFID for output @SC90264 01031000 .* READ Read a record from (already open) file @SC90264 01032000 .* READ TD Read a record from (already open) TD queue @SC90264 01033000 .* READ TS Read a record from (already open) TS queue @SC90264 01034000 .* TEST Check whether file named in FABFID exists @SC90264 01035000 .* WRIT TD Write a record to (already open) TD queue @SC90264 01036000 .* WRIT TS Write a record to (already open) TS queue @SC90264 01037000 .* WRITE Write a record to (already open) file @SC90264 01038000 FABDWDS EQU (*-FABD+7)/8 @SC86295 01039000 MEND 01040000 *COPY FDBPAT 01041000 MACRO 01042000 FDBPAT &N,&RFM,&SIZ @SC88120 01043000 .* Define system-dependent part of output FDB patterns 01044000 .* &1: variable-name prefix (or null if defining init. values) 01045000 .* &2: RECFM (1-char), &3: LRECL (skip rest of FDB if omitted)@SC88120 01046000 LCLC &R,&F,&L,&S,&P4 @SC90037 01047000 AIF ('&N' EQ '').ALC @SC86316 01048000 &R SETC 'RCF' @SC88120 01049000 &F SETC 'FLGS' @SC88120 01050000 &L SETC 'LRC' @SC88120 01051000 &S SETC 'FSIZ' @SC90037 01052000 .ALC ANOP @SC86316 01053000 &N&R DC C'&RFM' RECFM @SC88120 01054000 &N&F DC X'00' Flags @SC88120 01055000 AIF ('&SIZ' EQ '').DONE @SC88120 01056000 &N&L DC Y(&SIZ) LRECL @SC88120 01057000 &N&S DC F'0' File size in Kbytes @SC90037 01058000 .DONE ANOP @SC88120 01059000 MEND 01060000 *COPY KFSBLKD @SC90264 01061000 MACRO @SC90264 01062000 KFSBLK 01063000 .* Map of Kermit File System block @SC90264 01064000 KFSBLK DSECT , @SC90264 01065000 KFSNEXT DS A Ptr to next block in chain @SC90264 01066000 KFSPREV DS A Ptr to previous block in chain @SC90264 01067000 KFSFUID DS CL(LFUID) User name @SC90264 01068000 KFSFNAM DS CL(LFFNM) File name @SC90264 01069000 KFSDAT EQU * Info about file @SC90264 01070000 KFSLRC DS H File record length @SC90264 01071000 KFSNREC DS H Number of records @SC90264 01072000 KFSSIZE DS F File size in bytes @SC90264 01073000 KFSDATE DS XL7 Time stamp: yyyymmddhhmmss @SC90264 01074000 KFSLEN EQU *-KFSDAT Length of block on disk @SC90264 01075000 DS X Spare for packing @SC90264 01076000 KFSDWDS EQU (*-KFSBLK+7)/8 @SC90264 01077000 MEND @SC90264 01078000 *COPY KSYSVAR 01079000 MACRO 01080000 KSYSVAR 01081000 .* Define system-dependent globally-known variables 01082000 CSAPTR DS F Ptr to common system area @SC90264 01083000 RTXTSV DS F Saved register for prompt @SC89214 01084000 STRBUF DS A Address of string editing buffer @SC90264 01085000 DSKSTT DS (FABDWDS)D Dummy FAB @SC90264 01086000 ORG DSKSTT+FDBD-FABD Start of FDB @SC90264 01087000 DSKFDB DS XL(FDBINFO) Room for FDB @SC86299 01088000 ORG DSKSTT+FABFID-FABD Start of file name @SC90264 01089000 DSKSTNM DS CL(LFID) @SC90264 01090000 ORG , @SC90264 01091000 DESTL DS H'0' Length @SC86299 01092000 DEST DS CL60 Default PREFIX @SC90264 01093000 LINLEN DS H Length of invocation buffer @SC90264 01094000 GTMLEN DS F Length of getmained area @NL90264 01095000 GTMSAV DS F Saved reg during DMSFREE @SC90264 01096000 GTLBUFP DS A Ptr to buffer for terminal input @SC90264 01097000 GTPBPTRS DS 2F Address and length of input buffer@SC88095 01098000 GTLPRPS DS 2F Ptrs to prompt (passed to GETLIN) @SC90264 01099000 ICPRGS DS 8F Saved registers for type-out @SC88026 01100000 ICPFL DS X Flag for type-out interception @SC87020 01101000 FSCTRMF DS X Flag for terminal activity @SC90264 01102000 FSCOTP DS H Current screen write adr @SC90264 01103000 * Storage for directory scan @SC90264 01104000 NXFFNL DS F Length of pattern @SC90264 01105000 NXPTR DS F Current search position @SC90264 01106000 NXPTR2 DS F Current search position for TS @SC90264 01107000 NXDEST DS CL(LFID) Pattern @SC90264 01108000 NXDNAM EQU NXDEST+1+LFUID Start of name part @SC90264 01109000 KUSERID DS CL(LFUID) Userid (to be filled at startup) @SC90264 01110000 CURFUID DS CL(LFUID) Current userid @SC90264 01111000 PTRKFS DS A Ptr to chain of internal files @SC90264 01112000 PTRFRE DS A Ptr to chain of free blocks @SC90264 01113000 PTRFREM DS A Ptr to chain of free megablocks @SC90264 01114000 USRTOTL DS F Total bytes for current user @SC90264 01115000 TMPBLK DS A Ptr to block for current file @SC90264 01116000 QFNBP DS A Ptr to ring of QFN buffers @SC90264 01117000 QFNPTR DS A Ptr to current QFN buffer 1 @SC90264 01118000 QFNSHB DS H Offset to display form of QFN 2 @SC90264 01119000 QFNSHL DS H Length of display form 3 @SC90264 01120000 DSKFL DS X Flags for disk search @SC90264 01121000 PLOAD EQU X'40' Auxiliary pgm loaded for pipes @SC90264 01122000 WARB EQU X'20' Arbitrary chars seen @SC90264 01123000 WFN EQU X'08' Filename contains wild chars @SC88246 01124000 NFFND EQU X'01' Found at least one file in search @SC90264 01125000 COPID DS CL3 CICS operator id @LM90264 01126000 CSCRNHT DS H Terminal screen height in lines @LM90264 01127000 CSCRNWD DS H Screen width in columns @LM90264 01128000 CSYSID DS CL4 Local CICS system name @LM90264 01129000 KTSGIDNE DS H Number of entries per TSGID @SC91150 01130000 KTSBPSEG DS X Log(length of TS segment) @SC91150 01131000 SCRLSTIO DS X Saved I/O code from SCRNIO @SC91150 01132000 MEND 01133000 *COPY KSYSTF 01134000 MACRO 01135000 KSYSTF 01136000 .* Define system-dependent globally-known constants and init. variables 01137000 .* symb .DS + label &P.DEFS mark start of variables/init. values 01138000 GBLC &STORDS @SC89268 01139000 LCLC &P 01140000 AIF ('&SYSECT' EQ '&STORDS').DS @SC89268 01141000 &P SETC 'I' For initial values 01142000 WTEXT STM 14,5,ICPRGS Save @SC89268 01143000 L 2,=A(ICPTYP) Call interception routine @SC89268 01144000 BR 2 @SC89268 01145000 KSYSATOE DC A(0) Normal TTY E/A translation @SC88302 01146000 KSYSETOA DC A(0) @SC88302 01147000 SYSATR DC AL1(ADOT,ABL+2,AI,A7) ."I7 System type=CICS @SC90264 01148000 LSYSATR EQU *-SYSATR Length of stuff for A-packet @SC88273 01149000 KFILE DC CL8'KERMFSF' Name of Kermit file system KSDS @SC90264 01150000 LIMKFS DC A(LIMDSK) User quota of storage in KSDS @SC90264 01151000 CUTKFS DC A(CUTDSK) Absolute cutoff ("disk full") @SC90264 01152000 SYSUID DC (LFUID)C'0',C'/' @SC90264 01153000 SYSTAKE DC C'KSYS.TD' File id for system KERMINI @SC90264 01154000 LSYST EQU *-SYSTAKE @SC86299 01155000 USRTAKE DC C'KINIT.TAKE' User init file @SC90264 01156000 LUSRT EQU *-USRTAKE @SC86299 01157000 KMAIL1 DC C'KERMAIL R(_...) ' System cmd for invoking mail@SC91150 01158000 KMAIL2 DC C' LIST(' @SC90037 01159000 KMAIL3 DC C')' @SC90037 01160000 KPRNT1 DC C'KERMPRT R(_...) ' System cmd for printing @SC91150 01161000 KPRNT2 DC C' OPTIONS(' @SC90037 01162000 KPRNT3 DC C')' @SC90037 01163000 KSUBM1 DC C'KERMSUB R(_...) ' System cmd to submit job @SC91150 01164000 KSUBM2 DC C' OPTIONS(' @SC90037 01165000 KSUBM3 DC C')' @SC90037 01166000 * 01167000 FSCBEG DC H'1' Screen adr for first output line @SC90264 01168000 FSCEND DC Y(80*22-1) Limiting screen adr @SC90264 01169000 KSYSNIT CSECT @SC89215 01170000 .DS ANOP 01171000 &P.DEFS DS 0D 01172000 * 01173000 &P.KPRPL DC AL1(L'KPRPT) @SC87268 01174000 &P.KPRPT DC C'Kermit-CICS>' @SC90264 01175000 ORG &P.KPRPT+20 @SC87268 01176000 &P.LNDLM DC C' ' Initially no delimiter @SC88095 01177000 &P.LOGNAM DC C'KLOGxxxx.TS' File id for debug log @SC90264 01178000 &P.REPNAM DC C'KREPxxxx.TS' File id for reply from server @SC90264 01179000 MEND 01180000 *COPY KSYSBUF 01181000 MACRO 01182000 KSYSBUF 01183000 .* Store buffer ptrs from R1 and increment R1 for specific buffers 01184000 .* 01185000 ST 1,STRBUF Ptr to string editing buffer @SC90264 01186000 LA 1,256(,1) 8*N @SC90264 01187000 ST 1,GTLBUFP Ptr to terminal input buffer @SC90264 01188000 LA 1,256(,1) 8*N @SC90264 01189000 ST 1,QFNBP Ptr to ring of QFN buffers @SC90264 01190000 LA 1,((3*(QFNSIZ+4)+7)/8)*8(,1) 8*N @SC90264 01191000 MEND 01192000 *COPY SSYMS 01193000 MACRO 01194000 SSYMS 01195000 .* Set global symbols for conditional assembly 01196000 GBLC &KVRSN,&KSYS,&KDATE,&RTN,&TYPCMD,&S1CMD,&KCONT @SC88309 01197000 GBLC &KEDIT,&STORDS,&KTAG,&AEACMD @SC90173 01198000 GBLC &USER @SC90264 01199000 GBLA &MAXLR,&MAXBS @SC86268 01200000 &KSYS SETC 'CICS' System name @SC90264 01201000 MNOTE '*** Kermit-&KSYS release &KVRSN..&KEDIT &KTAG (&KDATE) ***' 01202000 &MAXLR SETA 32767 Max lrecl @SC91150 01203000 &MAXBS SETA 32767 Max blksize @SC86268 01204000 &S1CMD SETC '0X''0''' S/1 command prefix @SC90264 01205000 &AEACMD SETC '0X''0''' AEA command prefix (X'F3'=WSF) @SC90173 01206000 &KCONT SETC 'T' Default controller type (TTY) @SC88309 01207000 LIMDSK EQU 100000 User disk space quota for KSDS @SC90264 01208000 CUTDSK EQU 150000 Storage cutoff ("disk full") @SC90264 01209000 QFNSIZ EQU 54 Length of quoted file name @SC90264 01210000 MAXWT EQU 1024 Max TTY write buffer @SC90264 01211000 MAXRT EQU 1024 Max TTY read buffer @SC90264 01212000 MAXWS EQU 1920 Max fullscreen input buffer @SC90277 01213000 MAXRS EQU 1920 Max fullscreen output buffer @SC90277 01214000 MAXDOF EQU LFKEY Data offset into buffer @SC90264 01215000 STMGT EQU 0 Overhead for storage mngmnt @SC90264 01216000 &TYPCMD SETC 'TYPE' Host command for TYPE @SC90264 01217000 TYPMIN EQU 2 Min abbrv of system TYPE cmd or 2 @SC90264 01218000 FBRK1 EQU C'<' Starting character for options @SC89218 01219000 FBRK2 EQU C'>' Ending character for options @SC89218 01220000 KMAXE EQU 1920 < 9025 Kermit extended max pkt @SC90264 01221000 STKDWDS EQU 511 Size of save-area stack @SC87012 01222000 &STORDS SETC 'DFHEISTG' Append Kermit globals to STG @SC90264 01223000 KSUBBASE EQU 12 Base register for CSECT @SC89268 01224000 KWRKBASE EQU 11 Base register for work area @SC89268 01225000 &USER SETC 'OPID' Use OPID for id @SC90264 01226000 WXTRN KVALID External security routine @SC90264 01227000 WXTRN KHOST,KHIDE External security routine @SC90264 01228000 MEND @SC86268 01229000 *COPY SYSMACS 01230000 MACRO 01231000 SYSMACS 01232000 .* Include system control block definition macros and list all macros 01233000 MNOTE '---COPIES: DFHCSADS, DFHDCTDS, DFHTSMDS' 01234000 MNOTE '---MACROS: DFHEIEND, DFHEIENT, DFHEIRET, DFHEISTG,' 01235000 MNOTE '--- EXEC' 01236000 KFSBLK , @SC90264 01237000 COPY DFHCSADS @SC90264 01238000 DCTCBAR EQU 8 Ptr to DCT entry @SC90264 01239000 COPY DFHDCTDS @SC90264 01240000 AIF ('&SYSPARM' GE '1.7').CICS2 @SC90264 01241000 TDDCTSDS EQU TDDCTCBA Ptr to DCB info CICS 1.6 @SC90264 01242000 DCTSDSTF EQU DCTDSTYP TYPEFILE status @SC90264 01243000 DCTSDSOP EQU X'80' Output @SC90264 01244000 DCTSDSRF EQU DCTDSCDT+36 @SC90264 01245000 DCTSDSBL EQU DCTDSCDT+62 @SC90264 01246000 DCTSDSRL EQU DCTDSCDT+82 @SC90264 01247000 .CICS2 ANOP @SC90264 01248000 TSMAPBAR EQU 1 @SC90264 01249000 TSGIDBAR EQU 1 @NL90264 01250000 TSUTBAR EQU 1 @NL90264 01251000 TSUTEAR EQU 1 @NL90264 01252000 COPY DFHTSMDS @SC90264 01253000 DROP TSMAPBAR @SC90264 01254000 DFHEISTG , @SC90264 01255000 MEND @SC86268 01256000 *COPY STRTMSGS 01257000 MACRO 01258000 &LABEL STRTMSGS 01259000 .* Print system-dependent start-up messages 01260000 &LABEL CLI S1HND,XON @SC87338 01261000 BNE STRT1Z @SC87338 01262000 CLI TRMTP,C'T' @SC87338 01263000 BE STRT1Z @SC87338 01264000 WTEXT 'Handshake is XON -- not needed' @SC87338 01265000 STRT1Z DS 0H @SC87338 01266000 MEND @SC87338 01267000 *COPY KMAIN 01268000 MACRO 01269000 &LABEL KMAIN &TYPE 01270000 .* Linkage conventions with system. 01271000 .* &1: ENTER if entering, RETURN if returning 01272000 GBLC &RTN @SC90264 01273000 AIF ('&TYPE' NE 'RETURN').ENT @SC89268 01274000 &LABEL DS 0H @SC90264 01275000 L DFHEIBR,DFHEIBP @SC91150 01276000 USING DFHEIBLK,DFHEIBR @SC91150 01277000 ICM 2,15,DFHEICAP Any comm area? @SC91150 01278000 BZ KR&SYSNDX No, issue a read @SC91150 01279000 CLC EIBCALEN,=H'7' Length of comm area? @SC91150 01280000 BL KR&SYSNDX Not long enough for a return code @SC91150 01281000 MVC 0(7,2),=C'R(....)' Set up for return code @SC91150 01282000 STM 15,15,2(2) Ok return it @SC91150 01283000 KR&SYSNDX DS 0H @SC91150 01284000 DROP DFHEIBR @SC91150 01285000 DFHEIRET Unlink @SC90264 01286000 MEXIT , @SC89268 01287000 .ENT AIF ('&TYPE' NE 'ENTER').OTH @SC89268 01288000 &LABEL DFHEIENT DATAREG=(KWRKBASE),CODEREG=(KSUBBASE), @LM90264+01289000 EIBREG=(4) @SC90264 01290000 L 10,=A(COMMON) Common code addressibility @SC86316 01291000 LA 0,STORAG @SC86295 01292000 LA 1,8*STODWDS Length of storage @SC86295 01293000 SR 15,15 Zero fill @SC86295 01294000 MVCL 0,14 @SC86295 01295000 LR 15,0 Start of stack @SC86295 01296000 A 0,=A(8*STKDWDS) End of stack @SC87012 01297000 STM 15,0,STKPTR @SC86295 01298000 ST 15,STKLO @SC89089 01299000 LR 15,KSUBBASE Get entry address @SC90264 01300000 MEXIT , @SC89268 01301000 .OTH MNOTE 12,'Invalid type &TYPE' @SC89268 01302000 MEND @SC87338 01303000 *COPY SETUSER @SC90264 01304000 MACRO @SC90264 01305000 &LABEL SETUSER 01306000 .* Grab appropriate userid according to global symbol &USER @SC90264 01307000 .* The code can use R0-9,14,15 but should avoid USING's @SC90264 01308000 .* Valid values: OPID, TERM, OTHER. @SC90264 01309000 GBLC &USER @SC90264 01310000 AIF ('&USER' NE 'OPID').CHKTRM @SC90264 01311000 &LABEL MVC KUSERID(3),COPID Set default directory @SC90264 01312000 MVI KUSERID+3,C' ' @SC90264 01313000 MEXIT @SC90264 01314000 .CHKTRM AIF ('&USER' NE 'TERM').CHKOTH @SC90264 01315000 &LABEL L 15,DFHEIBP @SC90264 01316000 MVC KUSERID,EIBTRMID-DFHEIBLK(15) @SC90264 01317000 MEXIT @SC90264 01318000 .CHKOTH AIF ('&USER' NE 'OTHER').ERR @SC90264 01319000 KCALL KUSER,KUSERID,EXT @SC90264 01320000 MEXIT @SC90264 01321000 .ERR MNOTE 12,'Invalid USER type &USER' @SC90264 01322000 MEND @SC90264 01323000 *COPY SAVE 01324000 MACRO 01325000 &LABEL SAVE ®S,&DUM,&TAG @SC90264 01326000 .* Save registers as in OS type-1 linkage 01327000 .* &1: (reg1,reg2) to save, &2 is not used, &3: optional eyecatcher 01328000 LCLA &LEN,&OFF @SC90264 01329000 LCLC &NAME @SC90264 01330000 AIF (N'®S NE 2).ER1 @SC90264 01331000 AIF ('&TAG' EQ '').NOTAG @SC90264 01332000 AIF ('&TAG' EQ '*').DEFTAG @SC90264 01333000 &NAME SETC '&TAG' @SC90264 01334000 &LEN SETA K'&TAG @SC90264 01335000 AGO .SETTAG @SC90264 01336000 .DEFTAG ANOP @SC90264 01337000 &NAME SETC '&LABEL' @SC90264 01338000 &LEN SETA 1 @SC90264 01339000 AIF ('&LABEL' NE '').LOOPC @SC90264 01340000 &NAME SETC '&SYSECT' @SC90264 01341000 .LOOPC AIF ('&NAME'(1,&LEN) EQ '&NAME').SETTAG @SC90264 01342000 &LEN SETA &LEN+1 @SC90264 01343000 AGO .LOOPC @SC90264 01344000 .SETTAG ANOP @SC90264 01345000 &OFF SETA ((&LEN+6)/2)*2 @SC90264 01346000 &LABEL B &OFF.(,15) Skip over tag @SC90264 01347000 DC AL1(&LEN) Length of tag @SC90264 01348000 DC C'&NAME' Tag @SC90264 01349000 AGO .STOR @SC90264 01350000 .NOTAG ANOP @SC90264 01351000 &LABEL DS 0H @SC90264 01352000 .STOR AIF (T'®S(1) NE 'N').ER1 @SC90264 01353000 &OFF SETA ®S(1)*4+20 @SC90264 01354000 AIF (&OFF LE 75).OFFOK @SC90264 01355000 &OFF SETA &OFF-64 @SC90264 01356000 .OFFOK STM ®S(1),®S(2),&OFF.(13) Save @SC90264 01357000 MEXIT @SC90264 01358000 .ER1 MNOTE 12,'INVALID REGISTER LIST ®S' @SC90264 01359000 MEND @SC90264 01360000